home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 March / Chip_2002-03_cd1.bin / zkuste / delphi / kolekce / d3456 / gmprintsuite_eval.exe / {app} / GmStream.pas < prev    next >
Pascal/Delphi Source File  |  2002-01-01  |  6KB  |  251 lines
  1. unit GmStream;
  2.  
  3. interface
  4.  
  5. uses Classes, GmTypes, Graphics;
  6.  
  7. type
  8.   TGmExtStream = class(TMemoryStream)
  9.   public
  10.     function ReadInteger: integer;
  11.     function ReadExtended: Extended;
  12.     function ReadStr: string;
  13.     function ReadBoolean: Boolean;
  14.     function ReadDateTime: TDateTime;
  15.     function ReadBrush: TGmBrush;
  16.     function ReadFont: TGmFont;
  17.     function ReadPen: TGmPen;
  18.     procedure LoadFromStream(AStream: TStream);
  19.     procedure ReadSubStream(ASubStream: TStream);
  20.     procedure SaveToStream(AStream: TStream);
  21.     procedure WriteInteger(AValue: integer);
  22.     procedure WriteExtended(AValue: Extended);
  23.     procedure WriteStr(const AValue: string);
  24.     procedure WriteBoolean(AValue: Boolean);
  25.     procedure WriteDateTime(AValue: TDateTime);
  26.     procedure WriteBrush(AValue: TGmBrush);
  27.     procedure WriteFont(AValue: TGmFont);
  28.     procedure WritePen(AValue: TGmPen);
  29.     procedure WriteSubStream(ASubStream: TStream);
  30.   end;
  31.  
  32. implementation
  33.  
  34. function FontStringToStyle(AStyle: string): TFontStyles;
  35. begin
  36.   Result := [];
  37.   if Pos('B', AStyle) <> 0 then Result := Result + [fsBold];
  38.   if Pos('I', AStyle) <> 0 then Result := Result + [fsItalic];
  39.   if Pos('U', AStyle) <> 0 then Result := Result + [fsUnderline];
  40.   if Pos('S', AStyle) <> 0 then Result := Result + [fsStrikeOut];
  41. end;
  42.  
  43.  
  44. function FontStyleToString(AStyle: TFontStyles): string;
  45. begin
  46.   Result := '';
  47.   if (fsBold in AStyle)      then Result := Result + 'B';
  48.   if (fsItalic in AStyle)    then Result := Result + 'I';
  49.   if (fsUnderline in AStyle) then Result := Result + 'U';
  50.   if (fsStrikeOut in AStyle) then Result := Result + 'S';
  51. end;
  52.  
  53. function TGmExtStream.ReadInteger: integer;
  54. begin
  55.   Read(Result, SizeOf(Result));
  56. end;
  57.  
  58. function TGmExtStream.ReadExtended: Extended;
  59. begin
  60.   Read(Result, SizeOf(Result));
  61. end;
  62.  
  63. function TGmExtStream.ReadStr: string;
  64. var
  65.   StringLength: integer;
  66. begin
  67.   StringLength := ReadInteger;
  68.   SetLength(Result, StringLength);
  69.   if StringLength > 0 then
  70.     Read(Result[1], StringLength)
  71. end;
  72.  
  73. function TGmExtStream.ReadBoolean: Boolean;
  74. begin
  75.   Read(Result, SizeOf(Result));
  76. end;
  77.  
  78. function TGmExtStream.ReadDateTime: TDateTime;
  79. begin
  80.   Read(Result, SizeOf(Result));
  81. end;
  82.  
  83. function TGmExtStream.ReadBrush: TGmBrush;
  84. var
  85.   ABrushStream: TGmExtStream;
  86. begin
  87.   ABrushStream := TGmExtStream.Create;
  88.   try
  89.     ABrushStream.LoadFromStream(Self);
  90.     Result.Color := ABrushStream.ReadInteger;
  91.     Result.Style := TBrushStyle(ABrushStream.ReadInteger);
  92.   finally
  93.     ABrushStream.Free;
  94.   end;
  95. end;
  96.  
  97. function TGmExtStream.ReadFont: TGmFont;
  98. var
  99.   AFontStream: TGmExtStream;
  100. begin
  101.   AFontStream := TGmExtStream.Create;
  102.   try
  103.     AFontStream.LoadFromStream(Self);
  104.     Result.Angle := AFontStream.ReadExtended;
  105.     Result.Color := AFontStream.ReadInteger;
  106.     Result.Name  := AFontStream.ReadStr;
  107.     Result.Size  := AFontStream.ReadInteger;
  108.     Result.Style := FontStringToStyle(AFontStream.ReadStr)
  109.   finally
  110.     AFontStream.Free;
  111.   end;
  112. end;
  113.  
  114. function TGmExtStream.ReadPen: TGmPen;
  115. var
  116.   APenStream: TGmExtStream;
  117. begin
  118.   APenStream := TGmExtStream.Create;
  119.   try
  120.     APenStream.LoadFromStream(Self);
  121.     Result.Color := APenStream.ReadInteger;
  122.     Result.Style := TPenStyle(APenStream.ReadInteger);
  123.     Result.Width := APenStream.ReadInteger;
  124.     Result.Mode  := TPenMode(APenStream.ReadInteger);
  125.   finally
  126.     APenStream.Free;
  127.   end;
  128. end;
  129.  
  130. procedure TGmExtStream.LoadFromStream(AStream: TStream);
  131. var
  132.   StreamSize: integer;
  133. begin
  134.   Clear;
  135.   //AStream.Seek(0, soFromBeginning);
  136.   AStream.ReadBuffer(StreamSize, SizeOf(StreamSize));
  137.   CopyFrom(AStream, StreamSize);
  138.   Seek(0, soFromBeginning);
  139.   //ShowMessage(IntToStr(size));
  140. end;
  141.  
  142. procedure TGmExtStream.SaveToStream(AStream: TStream);
  143. var
  144.   StreamSize: integer;
  145. begin
  146.   Seek(0, soFromBeginning);
  147.   StreamSize := Self.Size;
  148.   AStream.WriteBuffer(StreamSize, SizeOf(StreamSize));
  149.   AStream.CopyFrom(Self, StreamSize);
  150.   //ShowMessage(IntToStr(size));
  151. end;
  152.  
  153. procedure TGmExtStream.ReadSubStream(ASubStream: TStream);
  154. var
  155.   StreamSize: integer;
  156. begin
  157.   StreamSize := ReadInteger;
  158.   ASubStream.CopyFrom(Self, StreamSize);
  159. end;
  160.  
  161. procedure TGmExtStream.WriteInteger(AValue: integer);
  162. begin
  163.   Write(AValue, SizeOf(AValue));
  164. end;
  165.  
  166. procedure TGmExtStream.WriteExtended(AValue: Extended);
  167. begin
  168.   Write(AValue, SizeOf(AValue));
  169.   //showmessage(inttostr(self.Size));
  170. end;
  171.  
  172. procedure TGmExtStream.WriteStr(const AValue: string);
  173. var
  174.   StringLength: integer;
  175. begin
  176.   StringLength := Length(AValue);
  177.   WriteInteger(StringLength);
  178.   if StringLength > 0 then
  179.     Write(AValue[1], StringLength);
  180. end;
  181.  
  182. procedure TGmExtStream.WriteBoolean(AValue: Boolean);
  183. begin
  184.   Write(AValue, SizeOf(AValue));
  185. end;
  186.  
  187. procedure TGmExtStream.WriteDateTime(AValue: TDateTime);
  188. begin
  189.   Write(AValue, SizeOf(AValue));
  190. end;
  191.  
  192. procedure TGmExtStream.WriteBrush(AValue: TGmBrush);
  193. var
  194.   ABrushStream: TGmExtStream;
  195. begin
  196.   ABrushStream := TGmExtStream.Create;
  197.   try
  198.     ABrushStream.WriteInteger(AValue.Color);
  199.     ABrushStream.WriteInteger(Ord(AValue.Style));
  200.   finally
  201.     ABrushStream.SaveToStream(Self);
  202.     ABrushStream.Free;
  203.   end;
  204. end;
  205.  
  206. procedure TGmExtStream.WriteFont(AValue: TGmFont);
  207. var
  208.   AFontStream: TGmExtStream;
  209. begin
  210.   AFontStream := TGmExtStream.Create;
  211.   try
  212.     AFontStream.WriteExtended(AValue.Angle);
  213.     AFontStream.WriteInteger(AValue.Color);
  214.     AFontStream.WriteStr(AValue.Name);
  215.     AFontStream.WriteInteger(AValue.Size);
  216.     AFontStream.WriteStr(FontStyleToString(AValue.Style));
  217.   finally
  218.     AFontStream.SaveToStream(Self);
  219.     AFontStream.Free;
  220.   end;
  221. end;
  222.  
  223. procedure TGmExtStream.WritePen(AValue: TGmPen);
  224. var
  225.   APenStream: TGmExtStream;
  226. begin
  227.   APenStream := TGmExtStream.Create;
  228.   try
  229.     APenStream.WriteInteger(AValue.Color);
  230.     APenStream.WriteInteger(Ord(AValue.Style));
  231.     APenStream.WriteInteger(AValue.Width);
  232.     APenStream.WriteInteger(Ord(AValue.Mode));
  233.   finally
  234.     APenStream.SaveToStream(Self);
  235.     APenStream.Free;
  236.   end;
  237. end;
  238.  
  239. procedure TGmExtStream.WriteSubStream(ASubStream: TStream);
  240. var
  241.   StreamSize: integer;
  242. begin
  243.   StreamSize := ASubStream.Size;
  244.   WriteInteger(StreamSize);
  245.   ASubStream.Seek(0, soFromBeginning);
  246.   CopyFrom(ASubStream, StreamSize);
  247.   //ASubStream.CopyFrom(Self, StreamSize);
  248. end;
  249.  
  250. end.
  251.